COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	.SBTTL Free storage management:  FRINIT
C00004 00003	  GTFREE
C00009 00004	  RLFREE
C00012 00005	  LBMAP
C00014 ENDMK
C⊗;
.SBTTL Free storage management:  FRINIT

; Assembly variables

FREEST = DATEND+2	;Define start of free storage after end of interp data
FREEND = PCODE - 4	;Define end to be just before start of pcode
FREL = FREEND-FREEST+2	;Maximum = 40000 WORDS
FREL = FREL / 2
;FREL = 6140		;Maximum = 40000 WORDS

; Free storage block
DATA
.EVEN
LBEVT::	0		;Large block interlock event
FRLEFT::FREL		;Amount of free storage left (in words)
FREEPT::FREEST
;	-1		;Left bdry tag is negative.
;FREEST:	FREL*2		;Beginning of free storage.  Boundary tag.
;	.BLKW	FREL-2	;
;FREEND:	FREL*2		;End of free storage.  Boundary tag.
;	-1		;Right bdry tag is negative.

CODE
; Routine to initialize storage.  Need only call if you think
;	storage has been munged, or you want to start over for
;	some reason.
FRINIT:	;Initialization of the large block allocator
	EVMAK		;Make a new large block interlock event
	MOV (SP),LBEVT	;
	EVSIG 		;Give it one signal
	MOV #2*FREL,FREEST	;Lower inner tag
	MOV #2*FREL,FREEND	;Upper inner tag
	MOV #FREEST,FREEPT	;Roving free pointer
	MOV #-1,FREEST-2	;Reset outer tags
	MOV #-1,FREEND+2
	MOV #FREL,FRLEFT	;Amount of free storage available
	RTS PC			;Yes.  Return.

;  GTFREE

  COMMENT ⊗
  Routine to assign storage.  Amount of words requested in R0.
 	Location of first word in block (not the boundary tag) returned
 	in R0.
   The boundary tag method described in Knuth I.2.5 is
 	used.  Each block of storage has a boundary tag at
 	each end, with identical contents:  The number
 	of bytes in the whole area if available, and the opposite
 	of that if busy.  Artificial busy areas above and below
 	free storage.
    Modified 10/76 by arg
   ⊗

GTFREE:	EVWAIT LBEVT	;Wait until we can enter critical section
	MOV R2,-(SP)	;Save R2 on stack.
	ASL R0		;Convert words to bytes
	BGT 1$		;Asked for negative number of words?
	PUNT FRMS1	;Yes.  Complain.
    .IFZ LBDEBUG
1$:	ADD #4,R0	;Need 2 extra words for boundary tags
    .IFF
1$:	ADD #6,R0	;Need 2 extra words for boundary tags and one for trace
    .ENDC
	MOV FREEPT,R1	;R1 ← running LOC[LTAG[*]]
FRTRY::	CMP R1,#FREEND	;Are we off the end of free storage?
	BLOS 2$		;No.
	MOV #FREEST,R1	;Yes.  Reset pointer to beginning.
2$:	TST (R1)	;Is this area busy?  If so, its count is negative.
	BLE 3$		;Yes.
	CMP (R1),R0	;Do we have enough room here?
	BGE FFOUND	;Yes
	BR 4$		;No.
3$:	SUB (R1),R1	;Yes.  R1 ← LOC[LTAG[next] by subtraction.
	BR  5$
4$:	ADD (R1),R1	;R1 ← LOC[LTAG[next] by addition.
5$:	CMP R1,FREEPT	;Have we cycled all through free storage
	BNE FRTRY	;No.  Try again.
	PUNT FRMS2	;Yes.  No room!
FFOUND::BEQ FEXACT	;If 0, then exact fit.
	MOV R1,R2	;Divide the found block into FOUND and HOLE.
			;Thus, R1 = LOC[LTAG[FOUND]].
	ADD R0,R2	;R2 ← LOC[LTAG[HOLE]]
	NEG R0		;R0 ← negative (busy) count of FOUND.
	MOV R0,-2(R2)	;RTAG[FOUND] ← new FOUND count.
	MOV R0,-(SP)	;Save R0.
	ADD (R1),R0	;R0 ← new HOLE count.
	MOV R0,(R2)	;LTAG[HOLE] ← new HOLE count.
	MOV R2,FREEPT	;Free pointer ← LOC[LTAG[HOLE]]
	MOV R1,R2	;
	TST -(R2)	;
	ADD (R1),R2	;R2 ← LOC[RTAG[HOLE]].
	MOV R0,(R2)	;RTAG[HOLE] ← new HOLE count.
	MOV (SP)+,(R1)+	;LTAG[FOUND] ← new FOUND count.
FRRET::	MOV R1,R0	;R0 (result) ← LOC[LTAG[FOUND]] + 1.
	MOV -2(R0),R2	;
	NEG R2		;R2 ← count of length
	ASR R2		; in words
	SUB R2,FRLEFT	;Update amount of free storage left
	SUB #2,R2	; without the boundary words
    .IFNZ LBDEBUG
	MOV 2(SP),(R1)+	;Store the calling point in the area
        TST (R0)+	;Usable area starts one word later
	DEC R2		;
    .ENDC
6$:	CLR (R1)+	;Clear out a word
	SOB R2,6$	;Until done
	MOV (SP)+,R2	;Restore R2
	EVSIG LBEVT	;Can let others in now.
	RTS PC		;Done.
FEXACT::MOV R1,R2	;
	ADD (R1),R2	;R2 ← LOC[RTAG[FOUND]]+2
	MOV R2,FREEPT	;Free pointer ← LOC[next block]
	NEG (R1)+	;LTAG[FOUND] ← new (busy) count.
	NEG -(R2)	;RTAG[FOUND] ← new (busy) count.
	BR FRRET	;Ready to return
DATA
FRMS1::	ASCIE </GTFREE: R0 HAS BAD REQUEST WORD LENGTH/>
FRMS2::	ASCIE /FREE STORAGE EXHAUSTED/

;  RLFREE

; Routine to release free storage.  R0=LOC[LTAG[BLOCK]] + 1.
; Call the currently released block BLOCK, the adjacent one
;	below LOW, and the adjacent one above HIGH.
CODE
RLFREE:	EVWAIT LBEVT	;Wait for our turn in critical code.
    .IFNZ LBDEBUG
	TST -(R0)	;Go past initial word
    .ENDC
	TST -(R0)	;Check block size
	BLT 1$		;Reasonable?
	ALERR RLMS1	;No.  Already available space.
	RTS PC		;Give up & return
1$:	MOV R0,R1	;R1 ← LOC[LTAG[BLOCK]]
	SUB (R0),R0	;R0 ← LOC[LTAG[HIGH]]
	CMP (R1),-2(R0)	;Do the two bdry tags agree?
	BEQ 2$		;
	PUNT RLMS2	;No.  Storage munged!!
2$:	NEG (R1)	;Count is now positive in LTAG[BLOCK].
	ADD (R1),FRLEFT	;Update amount of available free storage
	TST -2(R1)	;Is LOW available?
	BLT MERGR	;No.  Cannot merge left.
	CMP FREEPT,R1	;Will FREEPT point into a vacuum?
	BNE 3$		;No.
	MOV R0,FREEPT	;Yes.  Reset FREEPT ← LOC[LTAG[HIGH]]
3$:	ADD -2(R1),(R1)	;Yes.  LTAG[BLOCK] ← New count
	MOV (R1),-2(R0)	;RTAG[BLOCK] ← New count
	MOV R0,R1	;
	SUB -2(R1),R1	;R1 ← LOC[LTAG[LOW]]
	MOV -2(R0),(R1)	;LTAG[LOW] ← New count
			;At this point, call LOW&BLOCK = BLOCK.
MERGR::	TST (R0)	;Is HIGH available?
	BLT RLRET	;No.  Prepare to return.
	ADD (R0),(R1)	;LTAG[BLOCK] ← New count
	CMP FREEPT,R0	;Will FREEPT point into a vacuum?
	BNE 4$		;No.
	MOV R1,FREEPT	;Yes.  Reset FREEPT ← LOC[LTAG[BLOCK]]
4$:	ADD (R0),R0	;R0 ← LOC[RTAG[HIGH]] + 2
			;At this point, call BLOCK&HIGH = BLOCK.
RLRET::	MOV (R1),-2(R0)	;RTAG[BLOCK] ← New count
	EVSIG LBEVT	;Let others into critical section now.
	RTS PC		;Done.
DATA
RLMS1::	ASCIE /RLFREE: FREEING ALREADY AVAILABLE SPACE/
RLMS2::	ASCIE /RLFREE: END TAGS DISAGREE/
;  LBMAP
CODE
LBMAP::
COMMENT ⊗ Prints the free storage map.  ⊗
	MOV R0,-(SP)	;Save R0
	MOV R1,-(SP)	;Save R1
	MOV R2,-(SP)	;Save R2
	MOV #FREEST,R2	;R2 ← LOC[first block]
1$:	TST (R2)	;Used or free?
	BGE 3$		;Free.
	CMP R2,#FREEND	;Used.  At the end yet?
	BLT 2$		;No
	MOV (SP)+,R2	;Yes. Restore R2
	MOV (SP)+,R1	;Restore R1
	MOV (SP)+,R0	;Restore R0
	RTS PC		;Done
2$:	MOV #CRLFX,R0	;
	JSR PC,TYPSTR	;
    .IFNZ LBDEBUG
	MOV 2(R2),R0	;Print who.
	JSR PC,TYPOCT	;
	MOV #' ,R0	;
	JSR PC,TYPCHR	;
    .ENDC
	MOV (R2),R0	;Print how much
	NEG R0		;
	JSR PC,TYPOCT	;
	SUB (R2),R2	;Move to next block
	BR 1$		;Treat next block
3$:	ADD (R2),R2	;Move past free block
	BR 1$		;Treat next block